home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Types.Mod (.txt) < prev    next >
Oberon Text  |  1994-11-25  |  2KB  |  67 lines
  1. Syntax10.Scn.Fnt
  2. Syntax12.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 25 Nov 94
  6. MODULE Types;    (* MB 11.10.91 *) (*<<<< mah 
  7. (* Power Macintosh *)
  8.     IMPORT Modules, Kernel, S := SYSTEM;
  9.     TYPE
  10.         Tag = POINTER TO TypeDesc;
  11.         Type* = POINTER TO TypeDesc;
  12.         TypeDesc* = RECORD
  13.             tdsize: LONGINT;
  14.             sentinel: LONGINT; (* -4 *)
  15.             tag: Tag;
  16.             ext0: RECORD
  17.                         filler: ARRAY 3 OF CHAR;
  18.                         extlev: SHORTINT
  19.                     END ;
  20.             name*: ARRAY 32 OF CHAR;
  21.             module*: Modules.Module
  22.          END ;
  23.     PROCEDURE This*(mod: Modules.Module; name: ARRAY OF CHAR): Type;
  24.         VAR type: Type; tag, i: LONGINT;
  25.     BEGIN
  26.         IF name # "" THEN
  27.             i := mod^.noftds;
  28.             WHILE i > 0 DO DEC (i); tag := mod^.typedescs+4*i;
  29.                 S.GET (tag, tag);
  30.                 S.GET(tag-4, type);
  31.                 DEC(S.VAL(LONGINT, type), 2); (* is marked as type desc *) 
  32.                 IF type.name = name THEN RETURN type END;
  33.             END
  34.         END;
  35.         RETURN NIL
  36.     END This;
  37.     PROCEDURE BaseOf*(t: Type; level: INTEGER): Type;
  38.     BEGIN
  39.         S.GET(S.VAL(LONGINT, t.tag) - 8 - 4*level, t);
  40.         IF t # NIL THEN
  41.             S.GET(S.VAL(LONGINT, t) - 4, t);
  42.             DEC(S.VAL(LONGINT, t), 2) (* is marked as type desc *)
  43.         END ;
  44.         RETURN t
  45.     END BaseOf;
  46.     PROCEDURE LevelOf*(t: Type): INTEGER;
  47.     BEGIN
  48.         RETURN LONG(t.ext0.extlev)
  49.     END LevelOf;
  50.     PROCEDURE TypeOf*(o: S.PTR): Type;
  51.         VAR type: Type;
  52.     BEGIN
  53.         S.GET(S.VAL(LONGINT, o)-4, type);
  54.         S.GET(S.VAL(LONGINT, type)-4, type);
  55.         DEC(S.VAL(LONGINT, type), 2); (* is marked as type desc *)
  56.         RETURN type
  57.     END TypeOf;
  58.     PROCEDURE NewObj*(VAR o: S.PTR; t: Type);
  59.         VAR otype: Type;
  60.     BEGIN
  61.         S.GET(S.VAL(LONGINT, o) - 4, otype);
  62.         DEC(S.VAL(LONGINT, otype), 2); (* is marked as type desc *)
  63.         IF BaseOf(t, LevelOf(otype)) # otype THEN o := NIL; RETURN END ;
  64.         o := S.VAL(S.PTR, Modules.NewRec (S.VAL (LONGINT, t.tag)))
  65.     END NewObj;
  66. END Types.
  67.